home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / alter.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  4.3 KB  |  115 lines
  1.       subroutine alter
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine changes the element or device parameters
  5. c
  6. c spice version 2g.6  sccsid=tabinf 3/15/83
  7.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  8.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  9.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  10.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  11.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  12.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  13.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  14.      7   irowno,jcolno,nttbr,nttar,lvntmp
  15. c spice version 2g.6  sccsid=cirdat 3/15/83
  16.       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
  17.      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
  18. c spice version 2g.6  sccsid=miscel 3/15/83
  19.       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
  20.      1  defas,rstats(50),iwidth,lwidth,nopage
  21. c spice version 2g.6  sccsid=blank 3/15/83
  22.       common /blank/ value(200000)
  23. c spice version 2g.6  sccsid=status 3/15/83
  24.       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
  25.      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
  26.      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
  27.       integer nodplc(64)
  28.       complex cvalue(32)
  29.       equivalence (value(1),nodplc(1),cvalue(1))
  30.       logical memptr
  31. c
  32.       integer xxor
  33.       dimension lnod(50),lval(50)
  34.       dimension chtitl(4)
  35.       data chtitl / 8hchange f,8hollowing,8h paramet,8hers     /
  36.       data lnod /10,14,16, 8,15,16,15,16,13, 8,
  37.      1           18,38,27,35, 8, 8,35, 5, 5, 5,
  38.      2            5, 5, 5, 5, 0, 0, 0, 0, 0, 0,
  39.      3           21,21,21,21,21,21,21,21,21,21,
  40.      4            8, 8, 8, 8, 8, 0, 0, 0, 0, 0 /
  41.       data lval / 5, 4, 4, 2, 1, 1, 1, 1, 4, 4,
  42.      1            3, 4, 4,16, 1, 1, 9, 2, 1, 1,
  43.      2           19,55,17,46, 0, 0, 0, 0, 0, 0,
  44.      3            1, 1, 1, 1, 1,17,17,17,17,17,
  45.      4            1, 1, 1, 1, 1, 0, 0, 0, 0, 0 /
  46. c
  47.       call title (0,lwidth,1,chtitl)
  48.       do 350 id=1,24
  49.       loc=locate(id)
  50.    10 if (loc.eq.0) go to 350
  51.       if (nodplc(loc+lnod(id)-2).ne.numcyc) go to 300
  52.       locv=nodplc(loc+1)
  53.       loc1=locate(id)
  54.    50 if (loc1.eq.0) go to 400
  55.       if (nodplc(loc1+lnod(id)-2).ne.0) go to 400
  56.       locv1=nodplc(loc1+1)
  57.       if (xxor(value(locv),value(locv1)).eq.0) go to 100
  58.       loc1=nodplc(loc1)
  59.       go to 50
  60. c
  61. c  copy changed values to the original tables
  62. c
  63. c  copy real part
  64. c
  65.   100 call copy8(value(locv),value(locv1),lval(id))
  66.       write (iofile,110) value(locv1)
  67.   110 format ('********      ',a8,'      ********')
  68. c
  69. c  treat non-node tables specially
  70. c
  71.   200 if (id.ge.11) go to 300
  72.       go to (300,210,220,300,230,240,230,240,260,260), id
  73.   210 if (nodplc(loc+4).eq.1) go to 300
  74.       if (memptr(nodplc(loc1+7))) call clrmem(nodplc(loc1+7))
  75.       call cpytb8(loc+7,loc1+7)
  76.       go to 300
  77.   220 if (nodplc(loc+4).eq.1) go to 300
  78.       if (memptr(nodplc(loc1+10))) call clrmem(nodplc(loc1+10))
  79.       call cpytb8(loc+10,loc1+10)
  80.       go to 300
  81.   230 itab=5
  82.       go to 250
  83.   240 itab=6
  84.   250 if (id.le.6) go to 255
  85.       if (memptr(nodplc(loc1+itab+1))) call clrmem(nodplc(loc1+itab+1))
  86.       call cpytb4(loc+itab+1,loc1+itab+1)
  87.   255 if (memptr(nodplc(loc1+itab+2))) call clrmem(nodplc(loc1+itab+2))
  88.       call cpytb4(loc+itab+2,loc1+itab+2)
  89.       if (memptr(nodplc(loc1+itab+3))) call clrmem(nodplc(loc1+itab+3))
  90.       call cpytb8(loc+itab+3,loc1+itab+3)
  91.       if (memptr(nodplc(loc1+itab+4))) call clrmem(nodplc(loc1+itab+4))
  92.       call cpytb8(loc+itab+4,loc1+itab+4)
  93.       if (memptr(nodplc(loc1+itab+5))) call clrmem(nodplc(loc1+itab+5))
  94.       call cpytb4(loc+itab+5,loc1+itab+5)
  95.       if (memptr(nodplc(loc1+itab+6))) call clrmem(nodplc(loc1+itab+6))
  96.       call cpytb8(loc+itab+6,loc1+itab+6)
  97.       go to 300
  98.   260 if (memptr(nodplc(loc1+5))) call clrmem(nodplc(loc1+5))
  99.       call cpytb8(loc+5,loc1+5)
  100. c
  101.   300 loc=nodplc(loc)
  102.       go to 10
  103.   350 continue
  104.       write (iofile,360)
  105.   360 format (//)
  106.       go to 500
  107. c
  108.   400 write (iofile,401) value(nodplc(loc1+1))
  109.   401 format ('0*error*:  parameter change failed',/,
  110.      1        '0*******:  ',a8,' is not in the original circuit')
  111.       nogo=1
  112. c
  113.   500 return
  114.       end
  115.